home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1995 November / EnigmA AMIGA RUN 02 (1995)(G.R. Edizioni)(IT)[!][issue 1995-11][Skylink CD].iso / earcd / misc / excalc1.lha / ExCalcV1.1 / Source / ExMathLib0.mod < prev    next >
Text File  |  1995-05-08  |  9KB  |  361 lines
  1. (*********************************************************************)
  2. (*                                                                   *)
  3. (* Module ExMathLib0 Copyright © 1995 by Computer Inspirations       *)
  4. (*                                                                   *)
  5. (* Design : Michael Griebling                                        *)
  6. (* Change : Original                                                 *)
  7. (*                                                                   *)
  8. (*********************************************************************)
  9.  
  10. MODULE ExMathLib0;
  11.  
  12. IMPORT LR := LongRealConversions, LM := MathIEEEDoubTrans,
  13.        X := ExNumbers;
  14.  
  15. VAR
  16.   ToRadians : X.ExNumType;
  17.   ToDegrees : X.ExNumType;
  18.   Fact500   : X.ExNumType;
  19.   Fact1000  : X.ExNumType;
  20.   Fact2000  : X.ExNumType;
  21.   Fact3000  : X.ExNumType;
  22.  
  23.  
  24. PROCEDURE ExNumToLongReal*(x : X.ExNumType) : LONGREAL;
  25. VAR
  26.   Num : LONGREAL;
  27.   Str : ARRAY 81 OF CHAR;
  28. BEGIN
  29.   (* Convert ExNum into LONGREAL via a string *)
  30.   X.ExNumToStr(x, 0, 0, Str);
  31.   IF LR.StringToReal(Str, Num) THEN
  32.     RETURN Num;
  33.   ELSE
  34.     RETURN 0.0D;
  35.   END;
  36. END ExNumToLongReal;
  37.  
  38.  
  39. PROCEDURE LongRealToExNum*(x : LONGREAL; VAR Result : X.ExNumType);
  40. VAR
  41.   Str : ARRAY 81 OF CHAR;
  42. BEGIN
  43.   (* Convert LONGREAL into an ExNum via a string *)
  44.   IF LR.RealToString(x, Str, 1, 52, TRUE) THEN
  45.     X.StrToExNum(Str, Result);
  46.   ELSE
  47.     Result := X.Ex0;
  48.   END;
  49. END LongRealToExNum;
  50.  
  51.  
  52. PROCEDURE xtoi*(VAR Result : X.ExNumType; x : X.ExNumType; i : LONGINT);
  53. (* From Knuth, slightly altered : p442, The Art Of Computer Programming, Vol 2 *)
  54. VAR
  55.   Y : X.ExNumType;
  56.   negative : BOOLEAN;
  57. BEGIN
  58.   Y := X.Ex1;
  59.   negative := i < 0;
  60.   i := ABS(i);
  61.   LOOP
  62.     IF ODD(i) THEN X.ExMult(Y, Y, x) END;
  63.     i := i DIV 2;
  64.     IF i = 0 THEN EXIT END;
  65.     X.ExMult(x, x, x);
  66.   END;
  67.   IF negative THEN
  68.     X.ExDiv(Result, X.Ex1, Y);
  69.   ELSE
  70.     Result := Y;
  71.   END;
  72. END xtoi;
  73.  
  74.  
  75. PROCEDURE Root *(VAR Result : X.ExNumType;
  76.                     x      : X.ExNumType;
  77.                     i      : LONGINT);
  78. (* Use iterative solution of a general root equation *)
  79. VAR
  80.   y, yp, f, g, t : X.ExNumType;
  81.   iteration : INTEGER;
  82.   root : LONGREAL;
  83.   negate : BOOLEAN;
  84. BEGIN
  85.   IF ((x.Sign = X.negative) & ~ODD(i)) OR (i < 2) THEN
  86.     X.ExStatus := X.IllegalNumber;
  87.     Result := X.Ex0;
  88.   ELSIF X.IsZero(x) THEN
  89.     Result := x;
  90.   ELSE
  91.     (* handle negative roots *)
  92.     IF x.Sign = X.negative THEN X.ExAbs(x); negate := TRUE
  93.     ELSE negate := FALSE
  94.     END;
  95.  
  96.     (* estimate of the ith root *)
  97.     root := 1.0D / i;
  98.     LongRealToExNum(LM.Pow(root,ExNumToLongReal(x)), yp);
  99.     X.ExNumb(i, 0, 0, f);    (* i *)
  100.     X.ExNumb(i-1, 0, 0, g);  (* i - 1 *)
  101.  
  102.     (* calculate the root *)
  103.     iteration := 4;
  104.     LOOP
  105.       (* y := 1/i * (yp * (i-1) + x / yp^(i-1)) *)
  106.       xtoi(t, yp, i-1);       (* yp**(i-1) *)
  107.       X.ExMult(y, t, yp);     (* yp**i *)
  108.       X.ExMult(y, y, g);      (* yp**i * (i-1) *)
  109.       X.ExAdd(y, y, x);       (* yp**i * (i-1) + x *)
  110.       X.ExMult(t, t, f);      (* yp**(i-1) * i *)
  111.       X.ExDiv(y, y, t);
  112.       IF (X.ExCompare(y, yp) = X.ExEqual) OR (iteration = 0) THEN EXIT END;
  113.       DEC(iteration);
  114.       yp := y;
  115.     END;
  116.  
  117.     (* adjust the number's sign *)
  118.     Result := y;
  119.     IF negate THEN X.ExChgSign(Result) END;
  120.   END;
  121. END Root;
  122.  
  123.  
  124. PROCEDURE powerof10(VAR Result : X.ExNumType; x : LONGINT);
  125. BEGIN
  126.   X.ExNumb(1, 0, SHORT(x), Result);
  127. END powerof10;
  128.  
  129.  
  130. PROCEDURE RadToDegX*(VAR radianAngle : X.ExNumType);
  131. (* Convert a radian measure into degrees *)
  132. BEGIN
  133.   X.ExMult(radianAngle, ToDegrees, radianAngle);
  134. END RadToDegX;
  135.  
  136.  
  137. PROCEDURE DegToRadX*(VAR radianAngle : X.ExNumType);
  138. (* Convert a degree measure into radians *)
  139. BEGIN
  140.   X.ExMult(radianAngle, ToRadians, radianAngle);
  141. END DegToRadX;
  142.  
  143.  
  144. PROCEDURE sqrtX*(VAR Result : X.ExNumType; x : X.ExNumType);
  145. BEGIN
  146.   Root(Result, x, 2);
  147. END sqrtX;
  148.  
  149.  
  150. PROCEDURE lnX*(VAR Result : X.ExNumType; x : X.ExNumType);
  151. BEGIN
  152.   LongRealToExNum(LM.Log(ExNumToLongReal(x)), Result);
  153. END lnX;
  154.  
  155.  
  156. PROCEDURE logX*(VAR Result : X.ExNumType; x : X.ExNumType);
  157. BEGIN
  158.   LongRealToExNum(LM.Log10(ExNumToLongReal(x)), Result);
  159. END logX;
  160.  
  161.  
  162. PROCEDURE factorial(VAR prevn, currentn : LONGINT;
  163.                     VAR PrevFact, Result : X.ExNumType);
  164. (* Implements an incremental factorial using a previously calculated value. *)
  165. VAR
  166.   i : LONGINT;
  167. BEGIN
  168.   FOR i := prevn+1 TO currentn DO
  169.     (* PrevFact := PrevFact * i; *)
  170.     X.ExNumb(i, 0, 0, Result);
  171.     X.ExMult(PrevFact, PrevFact, Result);
  172.   END;
  173.   prevn := currentn;
  174.   Result := PrevFact;
  175. END factorial;
  176.  
  177.  
  178. PROCEDURE factorialX*(VAR Result : X.ExNumType; n : LONGINT);
  179. CONST
  180.   MaxFactorial = 3249;
  181. VAR
  182.   fact : LONGINT;
  183.   prev : X.ExNumType;
  184. BEGIN
  185.   IF (n < 0) OR (n > MaxFactorial) THEN
  186.     X.ExStatus := X.IllegalNumber;
  187.     Result := X.Ex0;
  188.     RETURN;
  189.   END;
  190.   IF    n < 500  THEN prev := X.Ex1;      fact := 0
  191.   ELSIF n < 1000 THEN prev := Fact500;  fact := 500
  192.   ELSIF n < 2000 THEN prev := Fact1000; fact := 1000
  193.   ELSIF n < 3000 THEN prev := Fact2000; fact := 2000
  194.   ELSE                prev := Fact3000; fact := 3000
  195.   END;
  196.   factorial(fact, n, prev, Result);
  197. END factorialX;
  198.  
  199.  
  200. PROCEDURE expX*(VAR Result : X.ExNumType; x : X.ExNumType);
  201. VAR
  202.   xPower : LONGREAL;
  203. BEGIN
  204.   xPower := ExNumToLongReal(x);
  205.   X.ExFrac(x);
  206.   IF (ABS(xPower) < MAX(LONGINT)) & X.IsZero(x) THEN
  207.     xtoi(Result, X.e, ENTIER(xPower));
  208.   ELSE
  209.     LongRealToExNum(LM.Exp(xPower), Result);
  210.   END;
  211. END expX;
  212.  
  213.  
  214. PROCEDURE powerX*(VAR Result : X.ExNumType; x, y : X.ExNumType);
  215. VAR
  216.   yPower : LONGREAL;
  217. BEGIN
  218.   yPower := ExNumToLongReal(y);
  219.   X.ExFrac(y);
  220.   IF (ABS(yPower) < MAX(LONGINT)) & X.IsZero(y) THEN
  221.     xtoi(Result, x, ENTIER(yPower));
  222.   ELSE
  223.     LongRealToExNum(LM.Pow(yPower,ExNumToLongReal(x)),Result);
  224.   END;
  225. END powerX;
  226.  
  227.  
  228. PROCEDURE rootX*(VAR Result : X.ExNumType; x, y : X.ExNumType);
  229. VAR
  230.   yRoot : LONGREAL;
  231. BEGIN
  232.   yRoot := ExNumToLongReal(y);
  233.   X.ExFrac(y);
  234.   IF (ABS(yRoot) < MAX(LONGINT)) & X.IsZero(y) THEN
  235.     Root(Result, x, ENTIER(yRoot));
  236.   ELSE
  237.     yRoot := 1.0D / yRoot;
  238.     LongRealToExNum(LM.Pow(yRoot,ExNumToLongReal(x)),Result);
  239.   END;
  240. END rootX;
  241.  
  242.  
  243. PROCEDURE sinX*(VAR Result : X.ExNumType; x : X.ExNumType);
  244. BEGIN
  245.   LongRealToExNum(LM.Sin(ExNumToLongReal(x)), Result);
  246. END sinX;
  247.  
  248.  
  249. PROCEDURE cosX*(VAR Result : X.ExNumType; x : X.ExNumType);
  250. BEGIN
  251.   LongRealToExNum(LM.Cos(ExNumToLongReal(x)), Result);
  252. END cosX;
  253.  
  254.  
  255. PROCEDURE tanX*(VAR Result : X.ExNumType; x : X.ExNumType);
  256. BEGIN
  257.   LongRealToExNum(LM.Tan(ExNumToLongReal(x)), Result);
  258. END tanX;
  259.  
  260.  
  261. PROCEDURE arctanX*(VAR Result : X.ExNumType; x : X.ExNumType);
  262. BEGIN
  263.   LongRealToExNum(LM.Atan(ExNumToLongReal(x)), Result);
  264. END arctanX;
  265.  
  266.  
  267. PROCEDURE coshX*(VAR Result : X.ExNumType; x : X.ExNumType);
  268. BEGIN
  269.   LongRealToExNum(LM.Cosh(ExNumToLongReal(x)), Result);
  270. END coshX;
  271.  
  272.  
  273. PROCEDURE sinhX*(VAR Result : X.ExNumType; x : X.ExNumType);
  274. BEGIN
  275.   LongRealToExNum(LM.Sinh(ExNumToLongReal(x)), Result);
  276. END sinhX;
  277.  
  278.  
  279. PROCEDURE tanhX*(VAR Result : X.ExNumType; x : X.ExNumType);
  280. BEGIN
  281.   LongRealToExNum(LM.Tanh(ExNumToLongReal(x)), Result);
  282. END tanhX;
  283.  
  284.  
  285. PROCEDURE arccoshX*(VAR Result : X.ExNumType; x : X.ExNumType);
  286. VAR
  287.   Temp : X.ExNumType;
  288. BEGIN
  289.   (* Result = ln(x + sqrt(x*x - 1)) *)
  290.   X.ExMult(Temp, x, x);
  291.   X.ExSub(Temp, Temp, X.Ex1);
  292.   sqrtX(Temp, Temp);
  293.   X.ExAdd(Temp, x, Temp);
  294.   lnX(Result, Temp);
  295. END arccoshX;
  296.  
  297.  
  298. PROCEDURE arcsinhX*(VAR Result : X.ExNumType; x : X.ExNumType);
  299. VAR
  300.   Temp : X.ExNumType;
  301. BEGIN
  302.   (* Result = ln(x + sqrt(x*x + 1)) *)
  303.   X.ExMult(Temp, x, x);
  304.   X.ExAdd(Temp, Temp, X.Ex1);
  305.   sqrtX(Temp, Temp);
  306.   X.ExAdd(Temp, x, Temp);
  307.   lnX(Result, Temp);
  308. END arcsinhX;
  309.  
  310.  
  311. PROCEDURE arctanhX*(VAR Result : X.ExNumType; x : X.ExNumType);
  312. VAR
  313.   Temp, Temp2 : X.ExNumType;
  314. BEGIN
  315.   (* Result = ln((1 + x) / (1 - x)) / 2 *)
  316.   X.ExAdd(Temp, X.Ex1, x);
  317.   X.ExSub(Temp2, X.Ex1, x);
  318.   X.ExDiv(Temp, Temp, Temp2);
  319.   lnX(Result, Temp);
  320.   X.ExNumb(0, 5, 0, Temp);
  321.   X.ExMult(Result, Result, Temp);
  322. END arctanhX;
  323.  
  324.  
  325. PROCEDURE arcsinX*(VAR Result : X.ExNumType; x : X.ExNumType);
  326. BEGIN
  327.   LongRealToExNum(LM.Asin(ExNumToLongReal(x)), Result);
  328. END arcsinX;
  329.  
  330.  
  331. PROCEDURE arccosX*(VAR Result : X.ExNumType; x : X.ExNumType);
  332. BEGIN
  333.   (* Replacement algorithm *)
  334.   LongRealToExNum(LM.Acos(ExNumToLongReal(x)), Result);
  335. END arccosX;
  336.  
  337.  
  338. BEGIN
  339.   (* Initialize a few internal conversion constants *)
  340.   X.StrToExNum(
  341.   "5.729577951308232087679815481410517033240547246656420E+1",
  342.   ToDegrees);
  343.   X.StrToExNum(
  344.   "1.745329251994329576923690768488612713442871888541727E-2",
  345.   ToRadians);
  346.  
  347.   (* Speed up very large factorials *)
  348.   X.StrToExNum(
  349.   "1.220136825991110068701238785423046926253574342803193E+1134",
  350.   Fact500);
  351.   X.StrToExNum(
  352.   "4.023872600770937735437024339230039857193748642107146E+2567",
  353.   Fact1000);
  354.   X.StrToExNum(
  355.   "3.316275092450633241175393380576324038281117208105780E+5735",
  356.   Fact2000);
  357.   X.StrToExNum(
  358.   "4.149359603437854085556867093086612170951119194931810E+9130",
  359.   Fact3000);
  360. END ExMathLib0.
  361.